perm filename LOSS.LSP[TIM,LSP]4 blob
sn#715175 filedate 1983-06-14 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (grindef pairs)
C00005 ENDMK
Cā;
(grindef pairs)
(DEFUN PAIRS (X Y MUST-APPEAR FUN APPLY-CONSTRAINTS CONSTRAINTS
NIL-PAIRS)
(METER:INC METER:SCCPP-COUNT-ARRAY 0 1)
((LAMBDA (XXX)
(PROGN
(METER:INC METER:SCCPP-COUNT-ARRAY 1 1)
(MAPCAN
#'(LAMBDA (I)
(AND
(COND
(MUST-APPEAR
(PROGN
(METER:INC METER:SCCPP-COUNT-ARRAY 2 1)
(*CATCH
'OUT
(PROGN
(METER:INC METER:SCCPP-COUNT-ARRAY 3 1)
(MAPC
#'(LAMBDA (I)
(COND
((PROGN
(METER:INC METER:SCCPP-COUNT-ARRAY 4 1)
(MEMBER
(PROGN (METER:INC METER:SCCPP-COUNT-ARRAY
5
1)
(CDR I))
MUST-APPEAR))
(PROGN (METER:INC METER:SCCPP-COUNT-ARRAY
6
1)
(*THROW 'OUT T)))))
I)))))
(T))
(PROGN (METER:INC METER:SCCPP-COUNT-ARRAY 7 1)
(LIST I))))
XXX)))
(PROGN
(METER:INC METER:SCCPP-COUNT-ARRAY 8 1)
(MAPCAR #'CDR
(COND
((PROGN (METER:INC METER:SCCPP-COUNT-ARRAY 9 1)
(< (PROGN (METER:INC METER:SCCPP-COUNT-ARRAY
10
1)
(LENGTH X))
(+ (COND (NIL-PAIRS 1) (T 0))
(PROGN (METER:INC METER:SCCPP-COUNT-ARRAY
10
1)
(LENGTH Y)))))
(PAIRS1 (MAKE-POSSIBILITY-1 X
Y
FUN
APPLY-CONSTRAINTS
CONSTRAINTS
NIL-PAIRS)))
(T (PAIRS2 (MAKE-POSSIBILITY-2 Y
X
FUN
APPLY-CONSTRAINTS
CONSTRAINTS
NIL-PAIRS))))))))
*